'  ==========================================================================
'  |                                                                        |
'  | SQLitening Server                                                      |
'  |                                                                        |
'  ==========================================================================
'
'  Server Service for SQLite databases and flat files.
'
'  Data to server will be fromatted as follows
'      1 -  4  =  Total DataIn length as Dword
'      5 -  5  =  Flags as Byte
'      6 -  7  =  Request code as Integer
'      8 - 11  =  Value 1. Database or Set handle or other numeric value as Dword
'     12 - 15  =  Value 2. Column number or other numeric value as Dword
'     16 -  ?  =  Data. Format depends on request.
'
' Data from server will be fromatted as follows
'      1 -  4  =  Total DataOut length as Dword
'      5 -  5  =  Flags as Byte
'      6 -  7  =  Return code as Integer normally from the SQLite engine.
'      8 - 11  =  Value 1 as Dword.
'     12 -  ?  =  Data. Format depends on request.
'
'  ==========================================================================
'  PUBLIC DOMAIN SOFTWARE
'  The author or authors of this code dedicate any and all
'  copyright interest in this code to the public domain.
'  Anyone is free to copy, modify, publish, use, compile,
'  sell, or distribute the original code, either in source
'  code form or as a compiled binary, for any purpose,
'  commercial or non-commercial, and by any means.
'  Fred Meier - July 2010
'  ==========================================================================

#Compile Exe "..\Bin\SQLiteningServer.Exe"
#Dim All
#Resource "SQLitening.Pbr"

'============================<[ Equates ]>=============================
' ==========>>> Request Codes
%reqSel                 =  0
%reqExe                 =  1
%reqExeBind             =  2
%reqGetRowDataChunk     =  3
%reqSetRelNamedLocks    =  4
%reqSetBusyTimeout      =  5
%reqGetErrorName        =  6
%reqGetErrorNumber      =  7
%reqGetLastInserRowID   =  8
%reqGetChanges          =  9
%reqGetTotalChanges     = 10
%reqAttach              = 11
%reqClose               = 12
%reqCopyDatabase        = 13
%reqAboveRequireDab     = 15
%reqConnect             = 16
%reqOpen                = 17
%reqDisconnect          = 18
%reqGetFile             = 19
%reqPutFile             = 20
%reqRunProc             = 21
%reqGetStatus           = 22
%reqAdmin               = 23

' ==========>>> SQLitening return codes
%SQLitening_NoOpenDatabase          =  -7
%SQLitening_AccessDenied            =  -8
%SQLitening_FileDoesNotExist        =  -9
%SQLitening_FileOpenGetPutError     = -10
%SQLitening_LockTimeout             = -11
%SQLitening_InvalidKeyOrNotFound    = -17
%SQLitening_SendOrReceiveError      = -18
%SQLitening_InvalidStringOrRequest  = -19
%SQLitening_ErrorAtServer           = -20
%SQLitening_MiscError               = -21

' ==========>>> SQLite
%SQLITE3_OK             =   0   '*/ Successful result */
%SQLITE3_BUSY           =   5   '*/ The database file is locked */
%SQLite_AttemptWriteRO  =   8  'Attempt to write a readonly database
%SQLITE3_ROW            = 100   '*/ sqlite3_step() has another row ready */
%SQLITE3_DONE           = 101   '*/ sqlite3_step() has finished executing */
%SQLite_Dups            =  19   'Constraint violation.
%SQLITE_OPEN_READONLY   = &H00000001
%SQLITE_OPEN_CREATE     = &H00000004

' ==========>>> Service
%SERVICE_START_PENDING = &H2
%SERVICE_RUNNING = &H4
%SERVICE_STOP_PENDING     = &H3
%SERVICE_STOPPED          = &H1
%SERVICE_WIN32_OWN_PROCESS = &H00000010
%SERVICE_ACCEPT_STOP = &H00000001
%SERVICE_ACCEPT_SHUTDOWN = &H00000004
%SERVICE_CONTROL_STOP = &H00000001
%SERVICE_CONTROL_SHUTDOWN = &H00000005
%SERVICE_CONTROL_INTERROGATE = &H00000004
%INFINITE = &HFFFFFFFF???   ' Infinite timeout

' ==========>>> Misc
%WM_User = &H400
%WM_InitDialog = &H110
%WAIT_TIMEOUT = 258
%Tcp_Notify = %WM_USER + 4093
%FD_Accept = 8
%True = -1
%False = 0
%gkLogFileMaxSize = 600000
%gkLogFileTrimSize = 100000
%SQLiteningServerVersion = 140

' ==========>>> Conditional Compile Flags
%CompileExit_1_Connect = %False
%CompileExit_2_Disconnect = %False
%CompileExit_3_Access = %False
%CompileExit_4_Open = %False
%CompileExit_101_Start = %False
%CompileExit_102_Stop = %False
%CompileExits = %CompileExit_1_Connect or %CompileExit_2_Disconnect or %CompileExit_3_Access  or %CompileExit_4_Open or %CompileExit_101_Start or %CompileExit_102_Stop
%CompileStartServerMonitor = %False

'=============================<[ Types ]>==============================
TYPE ServiceTableEntry_TYPE
  lpServiceName as asCIIZ PTR
  lpServiceProc as LONG
END TYPE

TYPE ServiceStatus_TYPE
  dwServiceType as DWORD
  dwCurrentState as DWORD
  dwControlsAccepted as DWORD
  dwWin32ExitCode as DWORD
  dwServiceSpecificExitCode as DWORD
  dwCheckPoint as DWORD
  dwWaitHint as DWORD
END TYPE

TYPE SecurityAttributes_TYPE
  nLength as DWORD
  lpSecurityDescriptor as LONG
  bInheritHandle as LONG
END TYPE

TYPE LIST_ENTRY
    Flink AS LIST_ENTRY PTR
    Blink AS LIST_ENTRY PTR
END TYPE

TYPE RTL_CRITICAL_SECTION_DEBUG
    wType AS WORD
    CreatorBackTraceIndex AS WORD
    CriticalSection AS DWORD  ' actually, CRITICAL_SECTION PTR, but we can not do a circular reference
    ProcessLocksList AS LIST_ENTRY
    EntryCount AS DWORD
    ContentionCount AS DWORD
    Spare(0 TO 1) AS DWORD
END TYPE

TYPE CRITICAL_SECTION
    DebugInfo AS RTL_CRITICAL_SECTION_DEBUG PTR
    ' The following three fields control entering and exiting the critical
    ' section for the resource
    LockCount AS LONG
    RecursionCount AS LONG
    OwningThread AS DWORD    ' from the thread's ClientId->UniqueThread
    LockSemaphore AS DWORD
    SpinCount AS DWORD       ' force size on 64-bit systems when packed
END TYPE

' Listeners
Type Listeners_TYPE
   lTcpFileNumber as Long        'The PB filenumber associated with socket
   hSocket as Dword              'The operating system file handle.
End Type

'=========================<[ SQLite Declares ]>=========================
Declare Function sqlite3_backup_finish cdecl lib "sqlite3.dll" alias "sqlite3_backup_finish" (byval rhDabBu as Dword) as Long
Declare Function sqlite3_backup_init cdecl lib "sqlite3.dll" alias "sqlite3_backup_init" (byval rhSQLiteDest as Dword, rzDestName as Asciiz, byval hSQLiteSour as Dword, rzSourName as Asciiz) as Long
Declare Function sqlite3_backup_step cdecl lib "sqlite3.dll" alias "sqlite3_backup_step" (byval rhDabBu as Dword, byval rlPages as Long) as Long
Declare Function sqlite3_bind_blob cdecl lib "sqlite3.dll" alias "sqlite3_bind_blob" (byval rhSet as Dword, byval rlPos as Long, byval rsData as Dword, byval rlLen as Long, byval rhZero as Dword) as Long
Declare Function sqlite3_bind_double cdecl lib "sqlite3.dll" alias "sqlite3_bind_double" (byval rhSet as Dword, byval rlPos as Long, byval rsInt as Double) as Long
Declare Function sqlite3_bind_int cdecl lib "sqlite3.dll" alias "sqlite3_bind_int" (byval rhSet as Dword, byval rlPos as Long, byval rsInt as Long) as Long
Declare Function sqlite3_bind_int64 cdecl lib "sqlite3.dll" alias "sqlite3_bind_int64" (byval rhSet as Dword, byval rlPos as Long, byval rsInt as Quad) as Long
Declare Function sqlite3_bind_null cdecl lib "sqlite3.dll" alias "sqlite3_bind_null" (byval rhSet as Dword, byval rlPos as Long) as Long
Declare Function sqlite3_bind_text cdecl lib "sqlite3.dll" alias "sqlite3_bind_text" (byval rhSet as Dword, byval rlPos as Long, byval rsData as Dword, byval rlLen as Long, byval rhZero as Dword) as Long
Declare Sub      sqlite3_busy_timeout cdecl lib "sqlite3.dll" alias "sqlite3_busy_timeout" (byval rhDab as Dword, byval rlWaitMS as Long)
Declare Function sqlite3_changes cdecl lib "sqlite3.dll" alias "sqlite3_changes" (byval rhDab as Dword) as Long
Declare Function sqlite3_close cdecl lib "sqlite3.dll" alias "sqlite3_close" (byval rhDab as Dword) as Long
Declare Function sqlite3_column_blob cdecl lib "sqlite3.dll" alias "sqlite3_column_blob" (byval rhSet as Dword, byval rlCol as Long) as Dword
Declare Function sqlite3_column_bytes cdecl lib "sqlite3.dll" alias "sqlite3_column_bytes" (byval rhSet as Dword, byval rlCol as Long) as Long
Declare Function sqlite3_column_count cdecl lib "sqlite3.dll" alias "sqlite3_column_count" (byval rhSet as Dword) as Long
Declare Function sqlite3_column_name cdecl lib "sqlite3.dll" alias "sqlite3_column_name" (byval rhSet as Dword, byval rlCol as Long) as Long
Declare Function sqlite3_column_type cdecl lib "sqlite3.dll" alias "sqlite3_column_type" (byval rhSet as Dword, byval rlCol as Long) as Long
Declare Function sqlite3_enable_load_extension cdecl lib "sqlite3.dll" alias "sqlite3_enable_load_extension" (byval rhDab as Dword, byval rlOnOrOff as Long) as Long
Declare Function sqlite3_errcode cdecl lib "sqlite3.dll" alias "sqlite3_errcode" (byval rhDab as Dword) as Long
Declare Function sqlite3_errmsg cdecl lib "sqlite3.dll" alias "sqlite3_errmsg" (byval rhDab as Dword) as Long
Declare Function sqlite3_exec cdecl lib "sqlite3.dll" alias "sqlite3_exec" (byval Dword, byval rspStatements as Dword, byval rhZero as Dword, byval rhZero as Dword, byval rhZero as Dword) as Long
Declare Function sqlite3_finalize cdecl lib "sqlite3.dll" alias "sqlite3_finalize" (byval rhSet as Dword) as Long
Declare Function sqlite3_last_insert_rowid cdecl lib "sqlite3.dll" alias "sqlite3_last_insert_rowid" (byval rhDab as Dword) as Quad
Declare Function sqlite3_open_v2 cdecl lib "sqlite3.dll" alias "sqlite3_open_v2" (rzFilename as Asciiz, wrhDab as Dword, byval rlFlags as Long, byval rlNull as Long) as Long
Declare Function sqlite3_prepare_v2 cdecl lib "sqlite3.dll" alias "sqlite3_prepare_v2" (byval rhDab as Dword, byval rspStatement as Dword, byval rlLen as Long, ppVMM as Dword, byval pzTail as Asciiz ptr) as Long
Declare Function sqlite3_reset cdecl lib "sqlite3.dll" alias "sqlite3_reset" (byval rhSet as Dword) as Long
Declare Function sqlite3_threadsafe cdecl lib "sqlite3.dll" alias "sqlite3_threadsafe" () as Long
Declare Function sqlite3_initialize cdecl lib "sqlite3.dll" alias "sqlite3_initialize" () as Long
Declare Sub      sqlite3_sleep lib "sqlite3.dll" alias "sqlite3_sleep" (byval rlMilliseconds as Long)
Declare Function sqlite3_shutdown cdecl lib "sqlite3.dll" alias "sqlite3_shutdown" () as Long
Declare Function sqlite3_step cdecl lib "sqlite3.dll" alias "sqlite3_step" (byval rhSet as Dword) as Long
Declare Function sqlite3_total_changes cdecl lib "sqlite3.dll" alias "sqlite3_total_changes" (byval rhDab as Dword) as Long

'===================<[ WinAPI and Other Declares ]>====================
Declare Function CloseHandle LIB "KERNEL32.DLL" ALIas "CloseHandle" (BYVAL hObject as DWORD) as LONG
Declare Function CreateEvent LIB "KERNEL32.DLL" ALIas "CreateEventA" (lpEventAttributes as SecurityAttributes_TYPE, BYVAL bManualReset as LONG, BYVAL bInitialState as LONG, lpName as asCIIZ) as LONG
Declare Sub      DeleteCriticalSection LIB "KERNEL32.DLL" ALIAS "DeleteCriticalSection" (lpCriticalSection AS CRITICAL_SECTION)
Declare Sub      EnterCriticalSection LIB "KERNEL32.DLL" ALIAS "EnterCriticalSection" (lpCriticalSection AS CRITICAL_SECTION)
Declare Function FreeLibrary LIB "KERNEL32.DLL" Alias "FreeLibrary" (byval hLibModule as Dword) as Long
Declare Function GetCurrentProcessId LIB "KERNEL32.DLL" Alias "GetCurrentProcessId" () as Long
Declare Function GetModuleFileName LIB "KERNEL32.DLL" ALIAS "GetModuleFileNameA" (byval hModule as DWord, lpFileName AS Asciz, byval nSize as Long) as Long
Declare Function GetModuleHandle LIB "KERNEL32.DLL" ALIAS "GetModuleHandleA" (lpModuleName AS ASCIIZ) AS DWORD
Declare Function GetPrivateProfileString LIB "KERNEL32.DLL" ALIAS "GetPrivateProfileStringA" (lpApplicationName AS ASCIIZ, lpKeyName AS ASCIIZ, lpDefault AS ASCIIZ, lpReturnedString AS ASCIIZ, BYVAL nSize AS DWORD, lpFileName AS ASCIIZ) AS DWORD
Declare Function GetProcAddress LIB "KERNEL32.DLL" Alias "GetProcAddress" (byval hModule as Dword, lpProcName as Asciiz) as Long
Declare Sub      InitializeCriticalSection LIB "KERNEL32.DLL" ALIAS "InitializeCriticalSection" (lpCriticalSection AS CRITICAL_SECTION)
Declare Sub      LeaveCriticalSection LIB "KERNEL32.DLL" ALIAS "LeaveCriticalSection" (lpCriticalSection AS CRITICAL_SECTION)
Declare Function LoadLibrary LIB "KERNEL32.DLL" Alias "LoadLibraryA" (lpLibFileName as Asciz) as Long
Declare Function PulseEvent LIB "KERNEL32.DLL" ALIAS "PulseEvent" (BYVAL hEvent AS DWORD) AS LONG
Declare Function RegisterServiceCtrlHandler LIB "ADVAPI32.DLL" ALIas "RegisterServiceCtrlHandlerA" (lpServiceName as asCIIZ, BYVAL lpHandlerProc as DWORD) as DWORD
Declare Function SetEvent LIB "KERNEL32.DLL" ALIas "SetEvent" (BYVAL hEvent as DWORD) as LONG
Declare Function SetServiceStatus LIB "ADVAPI32.DLL" ALIas "SetServiceStatus" (BYVAL hServiceStatus as DWORD, lpServiceStatus as ServiceStatus_TYPE) as LONG
Declare Function StartServiceCtrlDispatcher LIB "ADVAPI32.DLL" ALIas "StartServiceCtrlDispatcherA" (lpServiceStartTable as ServiceTableEntry_TYPE) as LONG
Declare Function WaitForSingleObject LIB "KERNEL32.DLL" ALIas "WaitForSingleObject" (BYVAL hHandle as DWORD, BYVAL dwMilliseconds as DWORD) as DWORD
Declare Function WritePrivateProfileString LIB "KERNEL32.DLL" ALIAS "WritePrivateProfileStringA" (lpApplicationName AS ASCIIZ, lpKeyName AS ASCIIZ, lpString AS ASCIIZ, lpFileName AS ASCIIZ) AS LONG
Declare Function ZLibPack Lib "ZLib.dll" Alias "compress"(compr As Any, comprLen As Dword, buf As Any, byval buflen As Dword)As Long
Declare Function ZLibUnPack Lib "ZLib.dll" Alias "uncompress"(uncompr As Any, uncomprLen As Dword, compr As Any, byval lcompr As Dword)As Long

' ==========>>> Using Ones
Declare Function UsingExit(byval rlExit as Long, byval rhLogCodePtr as Dword, rsData as String) as Long
Declare Function UsingRunProc(byval rhDab as Dword, byval rlTcpFileNumber as Long, blParm1 as Long, blParm2 as Long, bsParm3 as String, bsParm4 as String) as Long

'============================<[ Globals ]>=============================
Global gwMaxChunkSizeK as Word               'Max Chunk Size in Thousands
Global giConnectionTimeout as Integer        'Minutes minutes to wait for message
Global gwLogFileNumber as Word               'File number for the log
Global ghWinHand as Dword                    'Main window handle
Global ghServiceStatusHandle as Dword        'Service handle
Global ghSystemTempDB as Dword               'System Temp DB handle

Global glFlags as Long                       'General purpose flags
                                                %gbfServerStartedOK = &H01
                                                %gbfServerStartUpFailed = &H02
                                                %gbfLogConnDcon = &H04
                                                %gbfLogInvalidInMessage = &H08
                                                %gbfCreateDatabaseAllowed = &H10
                                                %gbfTrimLogManually = &H20
Global glEndEventHandle as Long              'Event handle
Global glLocksEventHandle as Long            'Locks event handle
Global glKillTcpFileNumber as Long           'Tcp File Number to Kill, if one requested
                                             '
Global guCriticalSection as CRITICAL_SECTION ' Critical section handle
Global guaListeners() as Listeners_TYPE      'Array of files and their associated
                                             'socket that are listening for connections.
Global guServiceStatus as ServiceStatus_TYPE 'Service Status
Global gsServiceName as String               'Service name
Global gsaFACT() as String                   'File Access Control Table. Each entry has the
                                             'file name followed by a colon followed by the
                                             'passwords.  Each password begins and ends with $NUL

#if %CompileExits
   Global ghAllExitsAddr as Dword            'Address of the AllExits entry in SQLiteningServerExits.Dll
#endif

'=========================<[ Auxiliary Ruts ]>=========================

' ==========>>> Is File There
Function arIsFileThere(rsFileName as String) as Long
' Returns %True if file exists

   Local llA as Long

   llA = getattr(rsFileName)
   if err then exit function
   function = %True

End Function

' ==========>>> Get Ini
Function arGetIni(rsFile as Asciiz, rsSection as Asciiz, rsEntity as Asciiz, wsData as String) as Long

   Local llLen as Long
   Local lzpData as Asciz ptr

   ' Init stuff
   wsData = space$(16384)  ' starting size

   ' Get it
   do
   lzpData = strptr(wsData)
      llLen = GetPrivateProfileString(rsSection, rsEntity, $CRLF, @lzpData, len(wsData), rsFile)
      if llLen < len(wsData) - 2  then
         ' If returning data is just the defauld $CRLF then it was not found
         if left$(wsData, 2) = $CRLF then
            ReturnNotFound:
            reset wsData
            function = %SQLitening_InvalidKeyOrNotFound
         else
            wsData = rtrim$(left$(wsData, llLen), $NUL)
         end if
         exit do
      end if
      wsData = space$(len(wsData) + 1638400)  ' next size
      ' If for some reason the data is larger than max then .....
      if isfalse len(wsData) then goto ReturnNotFound
   loop

End Function

'====================<[ *** Process Request *** ]>=====================
Sub ProcessRequest(rsDataIn as String, _
                   wsDataOut as String, _
                   byval rlTcpFileNumber as Long)
'  DataIn fromatted as follows
'      1 -  2  =  Request code as Integer
'      3 -  6  =  Value 1. Database or Set handle or zero as Dword
'      7 - 10  =  Value 2. Column number or other numeric value as Dword
'     11 -  ?  =  Data. Format depends on request.
'
' DataOut will be fromatted as follows
'      1 -  2  =  Return code as Integer normally from the SQLite engine.
'      3 -  6  =  Value 1 as Dword.
'      7 -  ?  =  Data. Format depends on request.

   Local llA, llB as Long
   Local llRC as Long
   Local lhA as Dword
   Local llDataOffset as Long
   Local lsA, lsB, lsC as String
   Local lzpA as Asciiz Ptr

   ' Case on request code
   select case const cvi(rsDataIn)

   case %reqConnect
      ' Connect checks for correct client version, returns 0 if not valid, returns
      ' -1 if valid.  Acts like a ping. Is used to verify that the tcp open is actually
      ' talking to this service.   It also returns the TcpFileNumber
      wsDataOut = mki$(0) & mkdwd$(iif&(cvl(rsDataIn, 3) = %SQLiteningServerVersion, -1, 0)) & format$(rlTcpFileNumber)    ' answere yes (true) back as Value 1 and return the TcpFileNumber

   case %reqOpen
      ' Open -- database
      llA = cvdwd(rsDataIn, 3)   ' save the open flags
      ' If can't create then remove flag
      if isfalse (glFlags and %gbfCreateDatabaseAllowed) then llA = llA and not %SQLITE_OPEN_CREATE
      llRC = CheckFileAccesss(mid$(rsDataIn, 11), 4, rlTcpFileNumber, llA)
      if llRC = 0 then
         wsDataOut = mki$(sqlite3_open_v2(parse$(mid$(rsDataIn, 11), $BS, 1), lhA, llA, 0)) & mkdwd$(lhA)
         sqlite3_busy_timeout lhA, 10000  ' set default busy timeout
         sqlite3_enable_load_extension lhA, 1   ' set enable load extension

         ' Do the conditional compile for Open Exit#4
         #if %CompileExit_4_Open
            ' Call exit #4
            if cvi(wsDataOut) = 0 then
               call dword ghAllExitsAddr using UsingExit(4, codeptr(LogItFromExit), format$(lhA) & $BS & parse$(mid$(rsDataIn, 11), $BS, 1) & $BS & parse$(mid$(rsDataIn, 11), $BS, 2)) to llA
               if llA then mid$(wsDataOut, 1, 2) = mki$(llA)   ' Exit error so return it
            end if
         #endif

      else
         wsDataOut = mki$(llRC)
      end if

   case %reqSel
      ' rsDataIn starting at position 11 is as follows:
      ' 11 - 14 = length of Statement
      ' 15 - ?? = Statement
      ' ?? - ?? = length of ModChars
      ' ?? - ?? = ModChars

      ' Get Statement into lsA
      llA = cvl(rsDataIn, 11)
      lsA = mid$(rsDataIn, 15, llA)

      ' Get modchars into lsB
      lsB = mid$(rsDataIn, 15 + llA + 4, cvl(rsDataIn, 15 + llA))

      DoSel:
      ' Do Begin if requested
      llA = instr(lsB, "B")
      if llA then
         lsC = "Begin " & iif$(val(mid$(lsB, llA + 1)) = 2, "Exclusive", iif$(val(mid$(lsB, llA + 1)) = 1, "Immediate", ""))
         llRC = sqlite3_exec(cvdwd(rsDataIn, 3), strptr(lsC), 0, 0, 0)
      end if

      ' Do Sel if RC is %SQLITE3_OK
      if llRC = %SQLITE3_OK then llRC = SelectRows(cvdwd(rsDataIn, 3), cvl(rsDataIn, 7), rlTcpFileNumber, lsA)

      ' Release all locks if requested and RC is %SQLITE3_OK
      if llRC = %SQLITE3_OK and instr(lsB, "R") then SetRelNamedLocks mkq$(0) & mkl$(1) & "R", rlTcpFileNumber

      ' Were done --- If RC is OK then must return empty stirng cause the RDC message
      ' was already sent, if RC is bad then return it.
      if llRC then wsDataOut = mki$(llRC) else reset wsDataOut

   case %reqSetRelNamedLocks
      ' rsDataIn starting at position 11 is as follows:
      '      11 -  14 = length of LockNames
      '      15 - ?? = LockNames
      '      ?? - ?? = length of ModChars
      '      ?? - ?? = ModChars
      '      ?? - ?? = length of SelStatement
      '      ?? - ?? = SelStatement
      '      ?? - ?? = length of SelModChars
      '      ?? - ?? = SelModChars

      llRC = SetRelNamedLocks(mid$(rsDataIn, 3, 4) & mid$(rsDataIn, 11), rlTcpFileNumber)
      if isfalse llRC then

         ' Get Statement into lsA and ModChars into lsB
         lhA = 15 + cvl(rsDataIn, 11)          ' lhA has position of length of ModChars
         lhA += cvl(rsDataIn, lhA) + 4       ' lhA has position of length of SelStatement
         lsA = mid$(rsDataIn, lhA + 4, cvl(rsDataIn, lhA))
         lhA += cvl(rsDataIn, lhA) + 4       ' lhA has position of length of SelModChars
         lsB = mid$(rsDataIn, lhA + 4, cvl(rsDataIn, lhA))

         ' Do Sel if there is a select statement or modchars
         if len(lsA) + len(lsB) then goto DoSel else wsDataOut = mki$(llRC)

      else

         wsDataOut = mki$(llRC)

      end if

   case %reqExe
      ' Do the exe
      wsDataOut = mki$(sqlite3_exec(cvdwd(rsDataIn, 3), strptr(rsDataIn) + 10, 0, 0, 0))
      ' If flag &H01 is on then release all locks owned by this connection
      if (cvl(rsDataIn, 7) and &H01) then SetRelNamedLocks mkq$(0) & mkl$(1) & "R", rlTcpFileNumber

   case %reqExeBind
      ' Prepare the statement
      llRC = sqlite3_prepare_v2(cvdwd(rsDataIn, 3), strptr(rsDataIn) + 10 + 8, cvdwd(rsDataIn, 15), lhA, 0)
      if llRC = %SQLITE3_OK then

         ' Process each bind
         llB = cvl(rsDataIn, 11)
         llDataOffset = cvl(rsDataIn, 15) + 18         ' bump by first one which is the statement
         do while llDataOffset < len(rsDataIn)
   
            ' Incr bind index and check if ready to step
            incr llA
            if llB and llA > llB then
               ' Do step and reset
               llRC = sqlite3_step(lhA)
               if llRC = 101 then llRC = 0   '101 is not an error it means= sqlite_step() has finished executing
               sqlite3_reset lhA
               llA = 1
            end if
   
            ' Do the bind based on the type
            select case const$ mid$(rsDataIn, llDataOffset + 5, 1)
            case "B"
               llRC = sqlite3_bind_blob(lhA, llA, strptr(rsDataIn) + llDataOffset + 5, cvdwd(rsDataIn, llDataOffset + 1) - 1, 0)
            case "T"
               llRC = sqlite3_bind_text(lhA, llA, strptr(rsDataIn) + llDataOffset + 5, cvdwd(rsDataIn, llDataOffset + 1) - 1, 0)
            case "i"
               llRC = sqlite3_bind_int(lhA, llA, val(mid$(rsDataIn, llDataOffset + 6)))
            case "I"
               llRC = sqlite3_bind_int64(lhA, llA, val(mid$(rsDataIn, llDataOffset + 6)))
            case "D"
               llRC = sqlite3_bind_double(lhA, llA, val(mid$(rsDataIn, llDataOffset + 6)))
            case "Z"
               llRC = sqlite3_bind_null(lhA, llA)
            end select
            if llRC <> %SQLITE3_OK then exit if
            llDataOffset = llDataOffset + cvdwd(rsDataIn, llDataOffset + 1) + 4
         loop

         ' Do final step
         llRC = sqlite3_step(lhA)
         if llRC = 101 then llRC = 0   '101 is not an error it means= sqlite_step() has finished executing
      end if
      ' Set return code
      wsDataOut = mki$(llRC)
      ' Finalize
      sqlite3_finalize(lhA)
      ' If flag &H01 is on then release all locks owned by this connection
      if (cvl(rsDataIn, 7) and &H01) then SetRelNamedLocks mkq$(0) & mkl$(1) & "R", rlTcpFileNumber

   case %reqClose
      wsDataOut = mki$(sqlite3_close(cvdwd(rsDataIn, 3)))

   case %reqCopyDatabase
      wsDataOut = mki$(CopyDatabase(rsDataIn))

   case %reqSetBusyTimeout
      sqlite3_busy_timeout cvdwd(rsDataIn, 3), cvdwd(rsDataIn, 7)

   case %reqGetErrorName
      lzpA = sqlite3_errmsg(cvdwd(rsDataIn, 3))
      wsDataOut = mki$(0) & mkdwd$(0) & @lzpA

   case %reqGetErrorNumber
      wsDataOut = mki$(sqlite3_errcode(cvdwd(rsDataIn, 3)))

   case %reqGetRowDataChunk
      wsDataOut = GetRowDataChunk(cvdwd(rsDataIn, 3), cvl(rsDataIn, 7), cvdwd(rsDataIn, 11))

   case %reqGetLastInserRowID
      wsDataOut = mki$(0) & mkdwd$(0) & format$(sqlite3_last_insert_rowid(cvdwd(rsDataIn, 3)))

   case %reqGetChanges
      wsDataOut = mki$(sqlite3_changes(cvdwd(rsDataIn, 3)))

   case %reqGetTotalChanges
      wsDataOut = mki$(sqlite3_total_changes(cvdwd(rsDataIn, 3)))

   case %reqAttach
      ' Attach -- database must exist or be ":memory:"
      llRC = CheckFileAccesss(parse$(mid$(rsDataIn, 11), $VT, 1), 8, cvdwd(rsDataIn, 3))
      if llRC = 0 then
         lsA = "Attach '" & parse$(parse$(mid$(rsDataIn, 11), $BS, 1), $VT, 1) & "' as " & parse$(mid$(rsDataIn, 11), $VT, 2)
         wsDataOut = mki$(sqlite3_exec(cvdwd(rsDataIn, 3), strptr(lsA), 0, 0, 0))
      else
         wsDataOut = mki$(llRC)
      end if

   case %reqDisconnect
      wsDataOut = mki$(0)

   case %reqGetFile
      wsDataOut = mki$(GetAndPutFile(mid$(rsDataIn, 11), lsA, 1, cvl(rsDataIn, 3), rlTcpFileNumber)) & mkdwd$(0) & lsA

   case %reqPutFile
      llA = instr(mid$(rsDataIn, 11), $BEL)
      wsDataOut = mki$(GetAndPutFile(left$(mid$(rsDataIn, 11), llA - 1), mid$(mid$(rsDataIn, 11), llA + 1), 2, cvl(rsDataIn, 3), rlTcpFileNumber))

   case %reqRunProc
      wsDataOut = mki$(RunProc(cvdwd(rsDataIn, 3), cvl(rsDataIn, 7), mid$(rsDataIn, 11), lsA, rlTcpFileNumber)) & mkl$(0) & lsA

   case %reqGetStatus
      wsDataOut = mki$(GetStatus(cvl(rsDataIn, 7), lsA)) & mkl$(0) & lsA

   case %reqAdmin
      select case long cvl(rsDataIn, 3)
      case 1   ' Reload Config flags and FACT
         wsDataOut = mki$((LoadConfigDataAndFACT xor -1))
      case 2   ' List active connections
         wsDataOut = mki$(GetStatus(2, lsA)) & mkl$(0) & lsA
      case 3   ' Kill connection
         if glKillTcpFileNumber then
            glKillTcpFileNumber = cvl(rsDataIn, 11)
            wsDataOut = mki$(1)
         else
            glKillTcpFileNumber = cvl(rsDataIn, 11)
            wsDataOut = mki$(0)
         end if

      end select

   end select

End Sub

'===================<[ *** Run Server Thread *** ]>====================
Function RunServerThread(byval rlParm as Long) as Long
'  This is the thread that does the initialization of our service.
'  It must be a thread so the main thread can continue to tell the
'  service manager that we are 'Starting'

   Local llA as Long
   Local lsA as String
   Local lzpA as Asciiz Ptr
   Local luSA as SecurityAttributes_TYPE

   ' Init stuff.
   gwLogFileNumber = freefile

   ' This is a multi-threaded application.
   ' Uses a critical section to resolve thread conflicts
   InitializeCriticalSection guCriticalSection

   ' Log it
   LogIt 1, "Strt " & string$(10, "=") & "<[ Start Server " & format$(%SQLiteningServerVersion/100, "0.00") & " ]>" & string$(10, "=")

   ' SQLite must be thread safe
   if isfalse sqlite3_threadsafe() then lsA = "SQLite is not thread safe" : goto ErrorExit

   ' Init SQLite
   if sqlite3_initialize() then lsA = "SQLite initialize failed" : goto ErrorExit

   ' Open the SystemTemp database
   if sqlite3_open_v2("", ghSystemTempDB, 2, 0) then lsA = "Open" : goto CreateTempDBError
   lsA = "Create Table tblNamedLocks (OwnerTcpFileNumber, LockName, Status, SetTime, Unique(LockName, Status), Unique(LockName, OwnerTcpFileNumber))"
   if sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0) then CreateTempDBError
   lsA = "Create Table tblConnections (OwnerTcpFileNumber Unique, User, Computer, IPAddress, DateTime)"
   if sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0) then CreateTempDBError

   ' Create locks wait event
   glLocksEventHandle = CreateEvent(luSA, %TRUE, %FALSE, "")

   ' The config file is called SQLiteningServer.Cfg and it
   ' must be present and in the same directory as this program
   if isfalse arIsFileThere("SQLiteningServer.Cfg") then lsA = "Can not find SQLiteningServer.Cfg" : goto ErrorExit

   ' Load config data and file access table
   if isfalse LoadConfigDataAndFACT then lsA = "Can not process SQLiteningServer.Cfg" : goto ErrorExit

   ' Do the conditional compiled start up stuff here
   #if %CompileStartServerMonitor
      ' Start SQLitening Server Monitor.  If it does not start
      ' log error and exit
      llA = shell("SQLiteningServerMonitor " & format$(GetCurrentProcessId()) )
      if isfalse llA then lsA = "Starting SQLiteningServerMonitor.Exe" : goto ErrorExit
      LogIt 1, "Info Started Monitor"
   #endif

   #if %CompileExits
      ' Set the global exit processing address
      ghAllExitsAddr = LoadLibrary("SQLiteningServerExits")
      ghAllExitsAddr = GetProcAddress(ghAllExitsAddr, "AllExits")
      if isfalse ghAllExitsAddr then lsA = "Loading SQLiteningServerExits.Dll" : goto ErrorExit
      LogIt 1, "Info Loaded SQLiteningServerExits.Dll"
   #endif

   #if %CompileExit_101_Start
      ' Call Exit#101
      call dword ghAllExitsAddr using UsingExit(101, codeptr(LogItFromExit), "") to llA
      if llA then lsA = format$(llA) & " Starting SQLiteningServerExits.Dll" : goto ErrorExit
   #endif

   ' Create the required dialog.
   dialog new 0, gsServiceName,,, 0, 0, 100, 100 To ghWinHand
   dialog show modal ghWinHand call Dispatcher

   ' Done
   function = %True

CreateTempDBError:
   lzpA = sqlite3_errmsg(ghSystemTempDB)
   lsA = "Create Locks Database Error -- " & lsA & " -- " & @lzpA

ErrorExit:
   LogIt 5, lsA
   glFlags = glFlags or %gbfServerStartUpFailed

End Function

'====================<[ *** Connection Main *** ]>=====================
Function ConnectionMain(byval rqpAddr as Quad Ptr ) as Long
'  This function is a new thread.  It sits in a loop responding to requests
'  until the socket is closed (this generates an error and the loop bails
'  out. When it finishes, it closes the socket.

   Local llA, llB as Long
   Local llTcpFileNumber as Long
   Local lbFlags as Byte            ' &H01 - On = Valid connect has occurred
   Local liTimeOutCount as Word     ' Incr every time the connection times out
                                    ' Will disconnect if count >= 30 which is 30 minutes
   Local lhSocketNumber as Dword
   Dim lhaDBs(1 to 4) as Dword      'Array of open DataBases.
   Local lsA as String
   Local lsDataIn as String         'Data to server will be fromatted as follows
                                    '   1 -  4  =  Total DataIn length as Dword
                                    '   5 -  5  =  Flags as Byte
                                    '   6 -  7  =  Request code as Integer
                                    '   8 - 11  =  Value 1. Database or Set handle or other numeric value as Dword
                                    '  12 - 15  =  Value 2. Column number or other numeric value as Dword
                                    '  16 -  ?  =  Data. Format depends on request.
   Local lsDataOut as String        'Data from server will be fromatted as follows
                                    '   1 -  4  =  Total DataOut length as Dword
                                    '   5 -  5  =  Flags as Byte
                                    '   6 -  7  =  Return code as Integer normally from the SQLite engine.
                                    '   8 - 11  =  Value 1 as Dword.
                                    '  12 -  ?  =  Data. Format depends on request.

   ' Init stuff -- get parm data from the thread create
   llTcpFileNumber = lo(Dword, @rqpAddr)
   lhSocketNumber = Hi(Dword, @rqpAddr)

   ' Looping until tcp file is closed or shutting down server
   do

      ' Try to receive first chunk of data
      redim lsaDataIn(0 to 4) as String
      do
         ' Check if they went away
         if istrue err and err <> 24 then exit, exit

         ' Receive it
         errclear
         tcp recv llTcpFileNumber, 1024 * 32, lsaDataIn(0)
         if istrue len(lsaDataIn(0)) or istrue eof(llTcpFileNumber) then exit do

         ' Timeout so check if inactive too loog
         incr liTimeOutCount
         if liTimeOutCount >= giConnectionTimeout and giConnectionTimeout > 0 then
            err = 254
            goto Disconnect
         end if
         ' Check if they want to kill me
         if llTcpFileNumber = glKillTcpFileNumber then
            reset glKillTcpFileNumber
            err = 253
            goto Disconnect
         end if

         ' Sleep a little and try again
         sleep 5
      loop

      ' Reset time out count
      reset liTimeOutCount

      ' Receve any remaining chunks
      llA = cvdwd(lsaDataIn(0))
      if len(lsaDataIn(0)) < llA then

         ' There is more data
         llA = llA - len(lsaDataIn(0))
         do
            incr llB
            if llB > ubound(lsaDataIn) then redim preserve lsaDataIn(0 to llB + 5)
            tcp recv llTcpFileNumber, llA, lsaDataIn(llB)
            llA = llA - len(lsaDataIn(llB))
         loop while llA > 0 and len(lsaDataIn(llB))
         if llA <> 0 then
            ' Log invalid message if needed
            LogInvalidMessage:
            if (glFlags and %gbfLogInvalidInMessage) then LogIt 5, "Received wrong length message, first 64=" & left$(lsaDataIn(0), 64)
            exit function
         end if
      end if
      if err then exit do
      lsDataIn = join$(lsaDataIn(), "")

      ' Unpack if packed
      if cvbyt(lsDataIn, 5) = 1 then
         lsA = space$(cvdwd(lsDataIn, 16))
         ZLibUnPack byval strptr(lsA), len(lsA), byval strptr(lsDataIn) + 19, len(lsDataIn) - 19
      else
         lsA = mid$(lsDataIn, 16)
      end if

      ' The first request must be %reqConnect or %reqAdmin.
      if isfalse(lbFlags and &H01) then
         if cvi(mid$(lsDataIn, 6)) = %reqConnect then

            ' First request is connect command
            lbFlags = lbFlags or &H01

            ' Do the conditional compile for Connect Exit#1
            #if %CompileExit_1_Connect
               ' Call exit #1
               call dword ghAllExitsAddr using UsingExit(1, codeptr(LogItFromExit), format$(llTcpFileNumber) & $BS & format$(lhSocketNumber) & $BS & mid$(lsDataIn, 16)) to llA
               if llA then
                  ' Exit error so send it back
                  lsDataOut = mki$(llA)
                  goto ReturnData
               end if
            #endif

            ' Log it if needed
            if (glFlags and %gbfLogConnDcon) then LogIt 3, "#" & format$(llTcpFileNumber) & " SK " & format$(lhSocketNumber) & " " & mid$(lsDataIn, 16)

            ' Insert record in system temp database
            EnterCriticalSection guCriticalSection
            lsA = "Insert into tblConnections Values(" & format$(llTcpFileNumber) & ",'" & parse$(mid$(lsDataIn, 16), $BS, 1) & "','" & parse$(mid$(lsDataIn, 16), $BS, 2) & "','" & parse$(mid$(lsDataIn, 16), $BS, 3) & "','" & date$ & " " & time$ & "')"
            sqlite3_exec ghSystemTempDB, strptr(lsA), 0, 0, 0
            LeaveCriticalSection guCriticalSection

         elseif cvi(mid$(lsDataIn, 6)) <> %reqAdmin then

            ' First is not connect nor admin so log invalid message if needed.
            if (glFlags and %gbfLogInvalidInMessage) then LogIt 5, "First request not Connect"

            ' Send back error %SQLitening_SendOrReceiveError
            lsDataOut = mki$(%SQLitening_SendOrReceiveError)
            goto ReturnData

         end if
      end if

      ' Certain requests require a valid database handle(Dab)
      ' which is always in DataIn + 6.  SQLite may do undesirable
      ' things if called without one.
      if cvi(lsDataIn, 6) <= %reqAboveRequireDab then
         array scan lhaDBs(), = cvdwd(lsDataIn, 8), to llA
         if isfalse llA or isfalse cvdwd(lsDataIn, 8) then
            ' No Dab so send back a %SQLitening_NoOpenDatabase return
            lsDataOut = mki$(%SQLitening_NoOpenDatabase)
            goto ReturnData
         end if
      end if

      ' Process it
      ProcessRequest mid$(lsDataIn, 6, 10) & lsA, lsDataOut, llTcpFileNumber

      ' Check for slOpen.  If yes then save database handle for later closing
      if cvi(mid$(lsDataIn, 6)) = %reqOpen then
         array scan lhaDBs(), = 0, to llA
         if isfalse llA then
            llA = ubound(lhaDBs) + 1
            redim preserve lhaDBs(1 to llA + 3)
         end if
         lhaDBs(llA) = cvdwd(lsDataOut, 3)
      end if

      ' Send back results if not already done in ProcessRequest
      ReturnData:

      if len(lsDataOut) then SendClientTcpData llTcpFileNumber, lsDataOut

      ' Check for requested disconnect.  If yes then exit loop
      if cvi(mid$(lsDataIn, 6)) = %reqDisconnect then err = 255 : exit do

      ' Sleep a little
      sleep 5

   loop

Disconnect:
   ' We either had an error or we were requested to disconnect so
   ' close all databases(even the ones that were already closed cause its
   ' faster then removing the closed ones) and then the connection and
   ' delete all related row chunk overflow files.
   for llA = 1 to ubound(lhaDBs)
      if lhaDBs(llA) then
         lsA = dir$("Temp\RDC" & format$(lhaDBs(llA)) & "*")
         do while len(lsA)
            kill "Temp\" & lsA
            lsA = dir$
         loop
         sqlite3_close lhaDBs(llA)
      end if
   next

   ' Release all locks owned by this connection
   SetRelNamedLocks mkq$(0) & mkl$(1) & "R", llTcpFileNumber

   ' Close Tcp and log it
   tcp close llTcpFileNumber
   if (lbFlags and &H01) and (glFlags and %gbfLogConnDcon) then LogIt 4, "#" & format$(llTcpFileNumber) & " " & iif$(err = 57 or err = 0, "Dropped", iif$(err = 255, "Disconnect", iif$(err = 254, "TimeOut", iif$(err = 253, "Killed", "Error" & error$))))

   ' Delete record in system temp database
   EnterCriticalSection guCriticalSection
   lsA = "Delete from tblConnections Where OwnerTcpFileNumber=" & format$(llTcpFileNumber)
   llA = sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0)
   LeaveCriticalSection guCriticalSection

   ' Do the conditional compile for Disconnect Exit#2
   #if %CompileExit_2_Disconnect
      ' Call exit #2
      call dword ghAllExitsAddr using UsingExit(2, codeptr(LogItFromExit), format$(llTcpFileNumber) & $BS & format$(lhSocketNumber) & $BS & format$(err))
   #endif

End Function

'=============================<[ Log It ]>=============================
Sub LogIt(byval rlEntryType as Long, rsEntryData as String)
'   EntryType:
'        1 = Admn
'        2 = Host
'        3 = Conn
'        4 = Dcon
'        5 = Eror
'        6 = Exit

   Local llA as Long
   Local lsA as String

   ' Enter critical and open log file
   EnterCriticalSection guCriticalSection
   open "SQLiteningServer.Log" for append as gwLogFileNumber

   ' Put entry
   print #gwLogFileNumber, remove$(right$(date$, 2) & left$(date$, 5) & time$, any "-:") & " " & _
         choose$(rlEntryType, "Admn", "Host", "Conn", "Dcon", "Eror", "Exit") & " " & rsEntryData

   ' Check if it is time to trim the log
   if isfalse (glFlags and %gbfTrimLogManually) and lof(gwLogFileNumber) > %gkLogFileMaxSize then
      close gwLogFileNumber
      open "SQLiteningServer.Log" for binary as gwLogFileNumber
      seek gwLogFileNumber, %gkLogFileTrimSize
      get$ gwLogFileNumber, lof(gwLogFileNumber) - %gkLogFileTrimSize + 1, lsA
      llA = instr(lsA, $CRLF) + 2
      seek gwLogFileNumber, 1
      put$ gwLogFileNumber, mid$(lsA, llA)
      seteof gwLogFileNumber
   end if

   ' Close log file and leave critical
   close gwLogFileNumber
   LeaveCriticalSection guCriticalSection

End Sub

' ==========>>> Do the conditional compile for LogItExit
#if %CompileExits
   Sub LogItFromExit(rsEntryData as String)
      LogIt 6, rsEntryData
   End Sub
#endif

'=========================<[ Copy Database ]>==========================
Function CopyDatabase(rsDataIn as String) as Long

'  DataIn fromatted as follows
'      1 -  2  =  Request code as Integer. Always 13
'      3 -  6  =  Value 1. Current (FROM) Database handle
'      7 - 10  =  Value 2. Copied (TO) Database handle
'      11- 14  =  Number of database pages to copy before sleeping.
'                 Default is 100.  Pass -1 to copy all pages without sleeping.
'      15- 18  =  Number of milliseconds to sleep before copying more pages.
'                 Default is 10. This is ignored if P is -1.
'      19- ??  =  The optional DatabaseName is required when you want to copy a database
'                 other than Main.

   Local llRC as Long
   Local lhHandBU as Dword

   ' Init backup
   lhHandBU = sqlite3_backup_init(cvdwd(rsDataIn, 7), _
                                  "Main", _
                                  cvdwd(rsDataIn, 3), _
                                  mid$(rsDataIn, 19))
   if isfalse lhHandBU then function = %SQLitening_MiscError : exit function

   ' Step thru backup
   do
      llRC = sqlite3_backup_step(lhHandBu, cvl(rsDataIn, 11))
      if llRC = %SQLITE3_OK then
      sqlite3_sleep cvl(rsDataIn, 15)
      elseif llRC <> %SQLITE3_DONE then
         function = llRC
         exit function
      else
         exit do
      end if
   loop

   ' Finish backup
   function = sqlite3_backup_finish(lhHandBu)

End Function

'======================<[ Set Rel Named Locks ]>=======================
Function SetRelNamedLocks(byref rsDataIn as String, _
                          byval rlTcpFileNumber as Long) as Long
'  InData is as follows:
'       1 -  4 = rhDab
'       5 -  8 = length of LockNames
'       9 - ?? = LockNames
'      ?? - ?? = length of ModChars
'      ?? - ?? = ModChars

   Local llDo as Long
   Local llA as Long
   Local llWaitTimeLeft as Long
   Local llSetTime as Long
   Local lhA as Dword
   Local lbHaveWaiter, lbReleasedLock as Byte
   Local lsA as String
   Local lsLockNames, lsLockName as String
   Local lsModChars as String
   Local lzpA as Asciiz Ptr

   ' Parse the InData
   lsLockNames = mid$(rsDataIn, 9, cvl(rsDataIn, 5))
   lhA = 9 + cvl(rsDataIn, 5)       ' lhA has position of length of ModChars
   lsModChars = mid$(rsDataIn, lhA + 4, cvl(rsDataIn, lhA))

   ' Set wait time
   llA = instr(lsModChars, "T")
   if llA then llWaitTimeLeft = val(mid$(lsModChars, llA + 1))

   ' Enter critical section and do other init stuff
   EnterCriticalSection guCriticalSection

   ' Check if want to release all
   if instr(lsModChars, "R") then

      ' Release all locks onwned by this connection
      lsA = "Delete from tblNamedLocks where OwnerTcpFileNumber=" & format$(rlTcpFileNumber)
      if sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0) then SQLiteError

      ' Process waiters
      gosub ProcessWaiters

   end if

   ' Process each set lock name
   for llDo = 1 to parsecount(lsLockNames, $VT)
      lsLockName = trim$(parse$(lsLockNames, $VT, llDo))
      if left$(lsLockName, 1) = "+" then
         lsA = "Insert into tblNamedLocks Values(" & format$(rlTcpFileNumber) & ",'" & mid$(lsLockName, 2) & "', 0," & format$(llSetTime) & ")"
         llA = sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0)
         if llA then
            if llA <> %SQLite_Dups then SQLiteError

            ' Can't set lock so insert waiter
            lsA = "Insert into tblNamedLocks Values(" & format$(rlTcpFileNumber) & ",'" & mid$(lsLockName, 2) & "'," & format$(rlTcpFileNumber) & "," & format$(llSetTime) & ")"
            llA = sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0)
            if llA then
               if llA <> %SQLite_Dups then SQLiteError
               ' If we got here it means they tried to set same value more than once
               ' in same connection, so we just ignore it.
            else
               ' We have a real waiter
               lbHaveWaiter = %True
            end if
         end if

      ' Must begin with - or be empty or we have an error
      elseif len(lsLockName) and left$(lsLockName, 1) <> "-" then
         function = %SQLitening_InvalidStringOrRequest
         goto EndRut
      end if
   next

   ' Check for waiter
   do while lbHaveWaiter
      reset lbHaveWaiter

      ' Have waiter so check if there is any wait time left
      if llWaitTimeLeft then

         ' Leave critical section
         LeaveCriticalSection guCriticalSection

         ' Wait for locks to be released
         lhA = timer * 1000
         llA = WaitForSingleObject(glLocksEventHandle, llWaitTimeLeft)

         ' Enter critical section
         EnterCriticalSection guCriticalSection

         ' If the wait timed out or timer went over midnight then goto LockFailed
         if llA  = %WAIT_TIMEOUT or timer * 1000 < lhA then LockFailed
         llWaitTimeLeft -= timer * 1000 - lhA

         ' Check if there are any waiters for this connection
         lsA = "Select RowID from tblNamedLocks where OwnerTcpFileNumber=" & format$(rlTcpFileNumber) & " and Status <> 0"
         if sqlite3_prepare_v2(ghSystemTempDB, strptr(lsA), len(lsA) + 1, lhA, 0) then SQLiteError
         llA = sqlite3_step(lhA)
         if llA = %SQLITE3_ROW then

            ' Yes, there is still a waiter
            lbHaveWaiter = %True

         elseif llA <> %SQLITE3_DONE then
            goto SQLiteError

         end if

         ' Finalize set
         sqlite3_finalize lhA

      else

         ' Out of wait time so delete all of this lock-set for this connection
      LockFailed:
         lsA = "Delete from tblNamedLocks where OwnerTcpFileNumber=" & format$(rlTcpFileNumber) & " and SetTime=" & format$(llSetTime)
         if sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0) then SQLiteError

         ' Lock failed so return %SQLitening_LockTimeout
         function = %SQLitening_LockTimeout

         ' Process waiters and then end rut --- skipping any release names
         gosub ProcessWaiters
         goto EndRut

      end if

   loop

   ' Process each release lock name
   for llDo = 1 to parsecount(lsLockNames, $VT)
      lsLockName = parse$(lsLockNames, $VT, llDo)
      if left$(lsLockName, 1) = "-" then
         lsA = "Delete from tblNamedLocks where OwnerTcpFileNumber=" & format$(rlTcpFileNumber) & " and LockName='" & mid$(lsLockName, 2) & "'"
         if sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0) then SQLiteError
         lbReleasedLock = %True
      end if

      ' Process waiters if we released any locks
      if lbReleasedLock then gosub ProcessWaiters

   next

   ' Leave critical section
   EndRut:
   LeaveCriticalSection guCriticalSection

   ' Exit rut
   exit function

ProcessWaiters:
   ' Try again to set lock on the waiters for all connection in connection sequence
   lsA = "Select RowID from tblNamedLocks where Status <> 0 Order by OwnerTcpFileNumber"
   if sqlite3_prepare_v2(ghSystemTempDB, strptr(lsA), len(lsA) + 1, lhA, 0) then SQLiteError
   do
      llA = sqlite3_step(lhA)
      if llA = %SQLITE3_ROW then

         ' Try to set lock by updating status to 0
         lsA = "Update tblNamedLocks Set Status=0 where RowID=" & peek$(sqlite3_column_blob(lhA, 0), sqlite3_column_bytes(lhA, 0))
         llA = sqlite3_exec(ghSystemTempDB, strptr(lsA), 0, 0, 0)
         if llA and llA <> %SQLite_Dups then SQLiteError

      elseif llA = %SQLITE3_DONE then

         ' Done so finalize this set and exit get row(step) loop
         sqlite3_finalize lhA
         exit do

      else

         ' Had step error
         goto SQLiteError

      end if
   loop

   ' Paulse the event so threads can check if all locks are set and return
   PulseEvent glLocksEventHandle
   return

SQLiteError:
   ' Had serious SQLite error
   lzpA = sqlite3_errmsg(ghSystemTempDB)
   LogIt 5, "Process Locks Error -- " & lsA & " -- " & @lzpA
   function = %SQLitening_ErrorAtServer
   goto EndRut

End Function

'==========================<[ Stop Server ]>===========================
Sub StopServer()

   Local llDo as Long

   'Close dialog
   dialog end ghWinHand

   ' Close the listening sockets
   for llDo = 1 to ubound(guaListeners)
      tcp close guaListeners(llDo).lTcpFileNumber
   next

   ' Do the conditional compile for Stop Exit#102
   #if %CompileExit_102_Stop
      ' Call exit #102
      call dword ghAllExitsAddr using UsingExit(102, codeptr(LogItFromExit), "")
   #endif

   ' Shutdown SQLite
   if sqlite3_shutdown then LogIt 1, "SQLite shutdown failed"

   ' Log it
   LogIt 1, "Stop " & string$(10, "=") & "<[ Stop Server ]>" & string$(10, "=")

   ' Done with critical section
   DeleteCriticalSection guCriticalSection

End Sub

'======================<[ Send Client Tcp Data ]>======================
Sub SendClientTcpData(byval rlTcpFileNumber as Long, _
                      rsDataOut as String)
'  Send the passed DataOut back to client, packing if needed

   Local llA as Long
   Local lsA as String

   if len(rsDataOut) > 100 then
      ' Packing
      lsA = space$((len(rsDataOut)) * 1.2 + 12)
      llA = len(lsA)
      ZLibPack byval strptr(lsA), llA, byval strptr(rsDataOut), len(rsDataOut)
      ' Now the returning message is made up of ...
      '     -- first 5 bytes are total length for 4 and flag for 1
      '     -- last n bytes are length of unpacked data for 4 and then the packed data
      tcp send rlTcpFileNumber, mkdwd$(llA + 9) & mkbyt$(1) & mkdwd$(len(rsDataOut)) & left$(lsA, llA)
   else
      ' No Packing
      tcp send rlTcpFileNumber, mkdwd$(len(rsDataOut) + 5) & mkbyt$(0) & rsDataOut
   end if
   ' Check for error
   if err then LogIt 5, "Could not Send -- " & error$

End Sub

'======================<[ Build Row Data Chunk ]>======================
Function BuildRowDataChunk(byval rhSet as Dword, _
                           byval rlDoStep as Long, _
                           wsRowDataChunk as String) as Long

'   Steps thru rows building row data chunks (RDC) until end of set or RDC
'   size is >= gwMaxChunkSizeK. The built RDC is set into RowDataChunk. If
'   step returns error then RowChunk is empty and will return %False. A RDC is
'   formatted as follows: Each row is preceded by a Long length and each
'   column is preceded by a Byte length. The length values do not include the
'   length field itself. If the row length is larger than a Long then
'   a zero length row is returned (should never happen). If the column length
'   will not fit in a Byte(> 253) then the Byte contains 255 and it is followed
'   by a Dword length. If the column is NULL then its length will be 254
'   rather than zero.
'   RDC return format:
'        1 -   4 = Length of RDC not including self.
'        5 -   R = RDC
'      R+1 - R+4 = Position next RDC as Dword, zero if none
'   Return: %True  = There are more rows.
'           %False = Last row is in RDC or error and set is finalized.

   Local llDo as Long
   Local llRC as Long
   Local llRowIX as Long
   Local llColCount as Long
   Local llColLength as Long
   Local llRowLength as Long
   Local llChunkSize as Long
   Local llMaxChunkSize as Long
   Local lsRow as String
   Dim lsaRows(1 to 8000) as String

   ' Init stuff
   llColCount = sqlite3_column_count(rhSet)
   dim lsaColumns(0 to llColCount - 1) as String
   llMaxChunkSize = gwMaxChunkSizeK * 1000
   if rlDoStep then llMaxChunkSize = llMaxChunkSize \ 2  ' the first RDC will be smaller so it gets returned faster -- in theory.

   ' Loop until done or RDC is full
   do

      ' Step it if not already done
      if rlDoStep then
         llRC = sqlite3_step(rhSet)
         if llRC <> %SQLITE3_ROW then
            if llRC = %SQLITE3_DONE then
               ' Done so free this set and exit loop
               sqlite3_finalize rhSet
               exit do
            else
               ' Step has returned error so will reset RowDataChunk, LogIt, and exit
               reset wsRowDataChunk
               LogIt 5, "Step error=" & format$(llRC)
               exit function
            end if
         end if
      end if
      rlDoStep = %True

      ' Process each column in row
      for llDo = 0 to llColCount - 1

         ' Get col length and check if weird
         llColLength = sqlite3_column_bytes(rhSet, llDo)
         if llColLength and llColLength <= 253 then
            ' It is not weird
            lsaColumns(llDo) = mkbyt$(llColLength) & peek$(sqlite3_column_blob(rhSet, llDo), llColLength)
         elseif llColLength = 0 then

            ' Its zero so check type for NULL
            if sqlite3_column_type(rhSet, llDo) = 5 then
               lsaColumns(llDo) = mkbyt$(254)
            else
               lsaColumns(llDo) = mkbyt$(0)
            end if

         else

            ' It is too long so add a Long
            lsaColumns(llDo) = mkbyt$(255) & mkl$(llColLength) & peek$(sqlite3_column_blob(rhSet,  llDo), llColLength)

         end if
      next
      lsRow = join$(lsaColumns(), "")
      llRowLength = len(lsRow)

      ' Check if we have reached max chunk size
      if llChunkSize + llRowLength + 4 > llMaxChunkSize then

         ' This is not the first row and it would make the chunk
         '  too large so will return %True and exit loop
         if llChunkSize then
            function = %True
            exit do
         end if

      end if

      ' Add the row to the rows array
      incr llRowIX
      if llRowIX > ubound(lsaRows) then redim preserve lsaRows(1 to llRowIX + 2000)
      lsaRows(llRowIX) = mkl$(llRowLength) & lsRow
      llChunkSize = llChunkSize + llRowLength + 4

      ' Releash remainder of the current time-slice
      sleep 0

   loop

   ' Set RowDataChunk and exit
   wsRowDataChunk = mkl$(llChunkSize) & join$(lsaRows(), "")

End Function

'=======================<[ Check File Access ]>========================
Function CheckFileAccesss(rsFileAccessData as String, _
                          byval rlType as Long, _
                          byval rlTcpFileNumber as Long, _
                          optional byval rhData as Dword) as Long
'   FileAccessData has following values delimited by $BS:
'     1 = File or Proc Name
'     2 = Pass Word -- optional
'   Type:   1 = Doing GetFile so must also check for and deny access to
'               special files.
'           2 = Doing PutFile so must also check for and deny access to
'               special files.
'           4 = Doing SQLite Open
'           8 = Doing SQLite Attach
'          16 = Doing Proc
'   Data:   Value and use depends on Type as follows:
'              Ignored if Type 1.
'              Contains ModFlags if Type 2.
'                    ModFlags is: 1=Open with Shared lock.
'                                 2=Create file if not already there -- Put only.
'                                 4=Delete file if there -- Put only.
'                                 8=Truncate file after putting -- Put only.
'              Contains the SQLite open flags (Create and ReadOnly) if Type 4.
'              Contains the open database handle if Type 8.
' SqlLiteOpenFlags is only used if type is 3 -- SQLite Open.
'   Returns  0 if OK
'           %SQLitening_FileDoesNotExist if file does not exist
'           %SQLitening_AccessDenied if access denied
'           %SQLite_AttemptWriteRO if attaching read only

   Local llA as Long
   Local lsA as String
   Local lsFileName as String
   Local lsPassword as String
   Local lsPasswords as String

   ' Parse out file name and password
   lsFileName = ucase$(parse$(rsFileAccessData, $BS, 1))
   lsPassword = trim$(parse$(rsFileAccessData, $BS, 2))

   ' If SQLite open or attach and temp file or :Memory: just return
   if (rlType = 4 or rlType = 8) and (isfalse len(lsFileName) or lsFileName = ":MEMORY:") then goto ExitOK

   ' Check if exists.  Only Type 4 (SQLite Open) can create files, the file
   ' must already exist for all other types.
   if isfalse arIsFileThere(lsFileName) and _
              isfalse(rlType = 16) and _
              isfalse(rlType = 2 and istrue(rhData and 6)) and _
              isfalse(rlType = 4 and istrue(rhData and %SQLITE_OPEN_CREATE)) _
                        then function = %SQLitening_FileDoesNotExist : exit function

   ' File name can not have colon nor double dot nor begin with \.  This will insure
   ' the file is in current folder or below.
   if instr(lsFileName, ":") or instr(lsFileName, "..") or left$(lsFileName, 1) = "\" then function = %SQLitening_AccessDenied : exit function   ' invalid location so can not access

   ' If doing GetFile or PutFile then deny access to "special" files.
   ' Special files are ones that can not be changed or accessed.
   ' We first check for either for better speed.
   if rlType <= 2 then
      if lsFileName = "SQLITENINGSERVER.CFG" or _
         (rlType = 2 and _
          (left$(lsFileName, 5) = "TEMP\" or _        ' can't change anything in Temp folder
            (isfalse instr(lsFileName, "\") and _     ' can't change anything in service root folder
            (right$(lsFileName, 4) = ".DLL" or right$(lsFileName, 4) = ".EXE" or right$(lsFileName, 4) = ".CFG" or right$(lsFileName, 4) = ".LOG")))) then  function = %SQLitening_AccessDenied : exit function   ' special file so can not access

   end if

   ' Lookup file name in FACT
   array scan gsaFACT(), from 1 to len(lsFileName) + 1, = lsFileName & ":", to llA
   if isfalse llA then
      ' Not in FACT so if PutFile we can not access. This is because of the damage
      ' that can be done if coding error with PutFile.
      if rlType = 2 then function = %SQLitening_AccessDenied : exit function
      ' Not in FACT and not PutFile so we can access
      goto ExitOK
   end if
   lsPasswords = mid$(gsaFACT(llA), len(lsFileName) + 2)

   ' Check if file is protected
   if instr(lsPasswords, $NUL & "!" & $NUL) then function = %SQLitening_AccessDenied : exit function   ' can not access

   ' Lookup password
   llA = instr(lsPasswords, $NUL & lsPassword & $NUL)
   if isfalse llA then llA = instr(lsPasswords, $NUL & "*" & $NUL)
   if isfalse llA then function = %SQLitening_AccessDenied : exit function   ' password not there so can not access

   ' Check if read only.  If the percent sign(%) is anywhere in the password.
   if instr(lsPassword, "%") then

      select case long rlType
      case 4      ' SQLite Open
         ' OK if SQLite open for read only
         if (rhData and %SQLITE_OPEN_READONLY) then goto ExitOK

      case 8      ' SQLite Attach
         ' Must do the following to insure the SQLite open was read only.
         ' We use the pragma to set the user_version.  If sucessful then
         ' we know it was not read only, if fails with code %SQLite_AttemptWriteRO
         ' then the open was read only.  We always do a rollback so the user_version
         ' is not changed.
         lsA = "Begin;Pragma user_version=0;Rollback"
         if sqlite3_exec(rhData, strptr(lsA), 0, 0, 0) = %SQLite_AttemptWriteRO then
            ' Change user_version failed with error %SQLite_AttemptWriteRO so the open was for read only
            lsA = "Rollback"
            sqlite3_exec rhData, strptr(lsA), 0, 0, 0
            goto ExitOK
         end if

      case 1, 16      ' GetFile or Proc
         ' GetFile is always read only and Proc does not apply
         goto ExitOK

      end select

      ' Failed read only so return %SQLitening_AccessDenied -- access denied
      function = %SQLitening_AccessDenied : exit function

   end if

   ExitOK:
   ' Do the conditional compile for Access Exit#3
   #if %CompileExit_3_Access
      ' Call exit #3
      call dword ghAllExitsAddr using UsingExit(3, codeptr(LogItFromExit), format$(rlTcpFileNumber) & $BS & rsFileAccessData & string$(iif&(instr(rsFileAccessData, $BS), 1, 2), $BS) & format$(rlType) & $BS & format$(rhData)) to llA
      if llA then function = llA   ' Exit error so return it
   #endif

End Function

'==========================<[ Select Rows ]>===========================
Function SelectRows(byval rhDab as Dword, _
                    byval rlSetNumber as Long, _
                    byval rlTcpFileNumber as Long, _
                    rsStatement as String) as Long

   Local llDo as Long
   Local llRC as Long
   Local llFileNumber as Long
   Local lhSet as Dword
   Local lzpA as Asciiz Ptr
   Local lsColumnNames as String
   Local lsRDC as String

   ' Prepare it
   llRC = sqlite3_prepare_v2(rhDab, strptr(rsStatement), len(rsStatement) + 1, lhSet, 0)
   ' Len is + 1 cause there is a small performance advantage to be had by passing a len
   ' that is equal to the number of bytes in the input string including the nul-terminator byte.
   if llRC = %SQLITE3_OK then

      ' Prepare was OK so build column names and row data chunks (RDC).
      ' The first RDC will be sent back to client as soon as it is built.

      ' Build list of col names
      for llDo = 1 to sqlite3_column_count(lhSet)
         lzpA = sqlite3_column_name(lhSet, llDo - 1)
         if isfalse len(@lzPa) then exit for
         lsColumnNames = lsColumnNames & iif$(llDo > 1, $NUL, "") & @lzpA
      next

      ' Build the first row chunk but only if there was a select statement.  Rut will return %True if more RDCs
      ' An empty select statement does not return a prep error but will not step OK.
      if len(rsStatement) then llRC = BuildRowDataChunk(lhSet, %True, lsRDC)

      ' Send back the first/only row chunk
      SendClientTcpData rlTcpFileNumber, mki$(%SQLITE3_OK) & mkdwd$(0) & mkdwd$(len(lsColumnNames)) & lsColumnNames & lsRDC & iif$(llRC, mkdwd$(1), mkdwd$(0))

      ' If there are more RDCs then will build and write them now
      if llRC then

         ' Open RDC file
         llFileNumber = freefile
         mkdir "Temp"
         errclear
         open "Temp\RDC" & format$(rhDab) & "-" & format$(rlSetNumber) for binary as llFileNumber
         if err then
            LogIt 5, "Can not open RDC file"
            exit if
         end if

         ' Build and write the RDCs
         do while llRC
            llRC = BuildRowDataChunk(lhSet, %False, lsRDC)
            put$ llFileNumber, lsRDC
         loop

         ' Write the end of RDCs value (Long of 0) and close file
         put$ llFileNumber, mkl$(0)
         close llFileNumber

      end if

   else

      ' Prepare was not OK
      function = llRC

   end if

End Function

'========================<[ Get and Put File ]>========================
Function GetAndPutFile(rsFileName as String, _
                       bsFileData as String, _
                       byval rlGetOrPut as Long, _
                       byval rlModFlags as Long, _
                       byval rlTcpFileNumber as Long) as Long
'   FileName has following values delimited by $BS:
'     1 = File Name
'     2 = Pass Word -- optional
'   GetOrPut is: 1=Get, 2=Put.
'   ModFlags is: 1=Open with Shared lock.
'                2=Create file if not already there -- Put only.
'                4=Delete file if there -- Put only.
'                8=Truncate file after putting -- Put only.
'   ReturnCode:
'     0 = All OK
'     %SQLitening_FileDoesNotExist = File does not exist
'     %SQLitening_FileOpenGetPutError = File will not open

   Local llA as Long
   Local llFileNumber as Long
   Local llFilePosition as Long
   Local llGetLength as Long
   Local lsFileName as String

   llA = CheckFileAccesss(parse$(rsFileName, $VT, 1), rlGetOrPut, rlTcpFileNumber, rlModFlags)
   if llA = 0 then

      ' Init stuff
      lsFileName = parse$(parse$(rsFileName, $VT, 1), $BS, 1)
      llFilePosition = val(parse$(parse$(rsFileName, $VT, 1), $BS, 3))

      ' Seperate .Ini from Binary
      if instr(rsFileName, $VT) then

         ' .Ini file  -- Get or Put
         if rlGetOrPut = 1 then

            function = arGetIni(curdir$ & "\" & parse$(parse$(rsFileName, $VT, 1), $BS, 1), parse$(parse$(rsFileName, $VT, 2), $BS, 1), parse$(parse$(rsFileName, $VT, 2), $BS, 2), bsFileData)

         else

            if isfalse WritePrivateProfileString(parse$(parse$(rsFileName, $VT, 2), $BS, 1), _
                                                 parse$(parse$(rsFileName, $VT, 2), $BS, 2), bycopy bsFileData, curdir$ & "\" & parse$(parse$(rsFileName, $VT, 1), $BS, 1)) then function = %SQLitening_InvalidKeyOrNotFound

         end if

      else

         ' Binary file
         llFileNumber = freefile
         if (rlModFlags and &H01) then
            open parse$(rsFileName, $BS, 1) for binary lock shared as llFileNumber
         else
            open parse$(rsFileName, $BS, 1) for binary as llFileNumber
         end if
         if err then

            ' Will not open error
            function = %SQLitening_FileOpenGetPutError

         else

            ' Get or Put
            if rlGetOrPut = 1 then
               if llFilePosition then seek llFileNumber, llFilePosition
               llGetLength = val(parse$(parse$(rsFileName, $BS, 3), 2))
               get$ llFileNumber, iif&(llGetLength, llGetLength, lof(llFileNumber)), bsFileData
            else
               EnterCriticalSection guCriticalSection
               if llFilePosition = -1 then llFilePosition = lof(llFileNumber) + 1
               if llFilePosition then seek llFileNumber, llFilePosition
               put$ llFileNumber, bsFileData
               if isfalse llFilePosition or (rlModFlags and 8) then seteof llFileNumber

               ' Delete file if requested and length is zero
               if (rlModFlags and 4) and isfalse lof(llFileNumber) then
                  close llFileNumber
                  kill lsFileName
                  errclear
                  if arIsFileThere(lsFileName) then function = %SQLitening_FileOpenGetPutError
               end if
               LeaveCriticalSection guCriticalSection
            end if
            close llFileNumber
            if err then function = %SQLitening_FileOpenGetPutError

         end if
      end if

   else

      ' Does not exist
      function = llA

   end if

End Function

'============================<[ Run Proc ]>============================
Function RunProc(byval rhDab as Dword, _
                 byval rlFlags as Long, _
                 rsDataIn as String, _
                 wsDataOut as String, _
                 byval rlTcpFileNumber as Long) as Long
'   DataIn is as follows:
'       1 -  4 = blParm1
'       5 -  8 = blParm2
'       9 - 12 = length of rsProcName
'      13 - ?? = rsProcName
'      ?? - ?? = length of bsParm3
'      ?? - ?? = bsParm3
'      ?? - ?? = length of bsParm4
'      ?? - ?? = bsParm4
'   DataOut is as follows:
'       1 -  4 = blParm1
'       5 -  8 = blParm2
'       9 - ?? = length of bsParm3
'      ?? - ?? = bsParm3
'      ?? - ?? = length of bsParm4
'      ?? - ?? = bsParm4
'   Flags: 1=Load, 2=Unload, 4=Don't Unload

   Local lhProcsLibHand as Dword
   Local lhRutAddr as Dword
   Local llRC as Long
   Local llOffset, llLength as Long
   Local llParm1, llParm2 as Long
   Local lsParm3, lsParm4 as String

   ' Check password
   llRC = CheckFileAccesss(">" & mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 16, rlTcpFileNumber)
   if llRC = 0 then

      ' Set parms
      llParm1 = cvl(rsDataIn, 1)
      llParm2 = cvl(rsDataIn, 5)
      llOffset = 13 + cvl(rsDataIn, 9)
      llLength = cvl(rsDataIn, llOffset)
      lsParm3 = mid$(rsDataIn, llOffSet + 4, llLength)
      llOffset = llOffset + llLength + 4
      llLength = cvl(rsDataIn, llOffset)
      lsParm4 = mid$(rsDataIn, llOffSet + 4, llLength)

      ' Check if they passed an entry name
      if len(mid$(rsDataIn, 13 + 1, cvl(rsDataIn, 9) - 1)) then
         ' Yes we have an entry name so load and get address
         lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
         lhRutAddr = GetProcAddress(lhProcsLibHand, parse$(mid$(rsDataIn, 13 + 1, cvl(rsDataIn, 9) - 1), $BS, 1))
         if lhRutAddr then
            call dword lhRutAddr using UsingRunProc(rhDab, rlTcpFileNumber, llParm1, llParm2, lsParm3, lsParm4) to llRC
         else
            llRC = %SQLitening_InvalidStringOrRequest
         end if
         ' Free the lib if we can
         if isfalse (rlFlags and 4) then FreeLibrary(lhProcsLibHand)
      else
         ' No entry name then just load or free lib
         if (rlFlags and 1) then lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
         if (rlFlags and 2) then
            lhProcsLibHand = GetModuleHandle("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
            FreeLibrary(lhProcsLibHand)
         end if
      end if
   end if

   'Build returning data out and return
   wsDataOut = mkl$(llParm1) & mkl$(llParm2) & mkl$(len(lsParm3)) & lsParm3 & mkl$(len(lsParm4)) & lsParm4
   function = llRC

End Function

'=======================<[ Get Row Data Chunk ]>=======================
Function GetRowDataChunk(byval rhDab as Dword, _
                        byval rlSetNumber as Long,_
                        byval rlSeekPosition as Long) as String

   Local llFileNumber as Long
   Local lhA as Dword
   Local lhChunkSize as Dword
   Local lsA as String
   Local lsRDC as String

   llFileNumber = freefile
   lsA = "Temp\RDC" & format$(rhDab) & "-" & format$(rlSetNumber)
   open lsA for binary as llFileNumber
   if err then

      ' This should not happen so LogIt and return
      LogIt 5, "Can not open " & lsA & " Error=" & error$
      function = mki$(0)

   else

      ' Seek to next RDC and read for max chunk size + 4
      ' and set the chunk size for it
      seek llFileNumber, rlSeekPosition
      get$ llFileNumber, gwMaxChunkSizeK * 1000 + 4, lsRDC
      lhChunkSize = cvdwd(lsRDC, 1)

      ' Check if we read complete chunk + 4.  Its OK to
      ' read too much.  Only time we would not read enough
      ' is when a single row is larger than gwMaxChunkSizeK
      if len(lsRDC) < lhChunkSize + 8 then

         ' Did not read enough.  Must have a very LARGE row.
         ' Read what were short and concat to first read
         get$ llFileNumber, lhChunkSize + 8 - len(lsRDC), lsA
         lsRDC = lsRDC + lsA

      end if

      ' Close file and check for last chunk.  If the 4 bytes
      ' following this chunk are zero then this is the last chunk.
      close llFileNumber
      if cvdwd(lsRDC, lhChunkSize + 5) then
         lhA = rlSeekPosition + lhChunkSize + 4
      else
         reset lhA
      end if

      ' Return the RDC
      function = mki$(-1) & mkdwd$(0) & left$(lsRDC, lhChunkSize + 4) & mkdwd$(lhA)

   end if

End Function

'===========================<[ Get Status ]>===========================
Function GetStatus(byval rlRequest as Long, _
                   wsStatus as String) as Long
'   Request:
'      1 = Return Locks as follows:
'          Each named lock will be delimited by vertical tabs ($VT).
'          Lock data will be delimited by backspaces ($BS) as follows:
'              1 = Tcp file number that owns the lock
'              2 = Lock value
'              3 = Status (0 = Locked, <>0 = Waiting)
'              4 = Time lock set (Milliseconds after midnight)
'              5 = User
'              6 = Computer
'              7 = IPAddress
'              8 = Connect Date-Time
'      2 = Return Connections as follows:
'          Each connection will be delimited by vertical tabs ($VT).
'          Connection data will be delimited by backspaces ($BS) as follows:
'              1 = Tcp file number
'              2 = User
'              3 = Computer
'              4 = IPAddress
'              5 = Connect Date-Time
'
'      4 = Is Connection Active?

   Local llDo as Long
   Local llA as Long
   Local lhA as Dword
   Local lsA as String
   Local lzpA as Asciiz Ptr

   ' Process request
   select case long rlRequest
   case 1, 2

      ' Enter critical section and do other init stuff
      EnterCriticalSection guCriticalSection

      if rlRequest = 1 then

         ' Get all locks
         lsA = "Select tblNamedLocks.*, User, Computer, IPAddress, DateTime from tblNamedLocks, tblConnections on tblNamedLocks.OwnerTcpFileNumber = tblConnections.OwnerTcpFileNumber"
         if sqlite3_prepare_v2(ghSystemTempDB, strptr(lsA), len(lsA) + 1, lhA, 0) then SQLiteError
         do
            llA = sqlite3_step(lhA)
            if llA = %SQLITE3_ROW then
               reset lsA
               for llDo = 1 to 8
                  lsA &= iif$(llDo = 1, "", $BS) & peek$(sqlite3_column_blob(lhA, llDo - 1), sqlite3_column_bytes(lhA, llDo - 1))
               next
               wsStatus &= iif$(len(wsStatus), $VT, "") & lsA
            elseif llA = %SQLITE3_DONE then
               ' Done so finalize this set and exit get row(step) loop
               sqlite3_finalize lhA
               exit do
            else
               goto SQLiteError
            end if
         loop

      else

         ' Get all connections
         lsA = "Select * from tblConnections"
         if sqlite3_prepare_v2(ghSystemTempDB, strptr(lsA), len(lsA) + 1, lhA, 0) then SQLiteError
         do
            llA = sqlite3_step(lhA)
            if llA = %SQLITE3_ROW then
               reset lsA
               for llDo = 1 to 5
                  lsA &= iif$(llDo = 1, "", $BS) & peek$(sqlite3_column_blob(lhA, llDo - 1), sqlite3_column_bytes(lhA, llDo - 1))
               next
               wsStatus &= iif$(len(wsStatus), $VT, "") & lsA
            elseif llA = %SQLITE3_DONE then
               ' Done so finalize this set and exit get row(step) loop
               sqlite3_finalize lhA
               exit do
            else
               goto SQLiteError
            end if
         loop

      end if

      LeavCritical:
      ' Leave critical section
      LeaveCriticalSection guCriticalSection

   case 4

      ' Is connected so return Yes
      wsStatus = "Yes"

   case else
      function = %SQLitening_InvalidStringOrRequest
   end select

   ' Exit rut
   exit function

SQLiteError:
   ' Had serious SQLite error
   lzpA = sqlite3_errmsg(ghSystemTempDB)
   LogIt 5, "Get Status Error -- " & lsA & " -- " & @lzpA
   function = %SQLitening_ErrorAtServer
   goto LeavCritical

End Function

'===================<[ Load Config Data and FACT ]>===================
Function LoadConfigDataAndFACT as Long

   Local llDo, llDo2 as Long
   Local lsA as String
   Local lsEntries as String
   Local lsFile as String
   Local lsPasswords as String

   ' Set all config flags off and other values to their default
   glFlags = glFlags and not %gbfCreateDatabaseAllowed + %gbfLogConnDcon + %gbfLogInvalidInMessage + %gbfTrimLogManually
   gwMaxChunkSizeK = 500
   giConnectionTimeout = 30

   ' Set trim log flag -- must be done first
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "TrimLogManually", lsA
   if ucase$(lsA) = "YES" then
      glFlags = glFlags or %gbfTrimLogManually
   end if
   LogIt 1, "Flgs TrimLogManually=" & iif$((glFlags and %gbfTrimLogManually), "Yes", "No")

   ' Set log open close flag
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "LogConnDcon", lsA
   if ucase$(lsA) = "YES" then
      glFlags = glFlags or %gbfLogConnDcon
   end if
   LogIt 1, "Flgs LogConnDcon=" & iif$((glFlags and %gbfLogConnDcon), "Yes", "No")

   ' Set log invalid in message flag
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "LogInvalidInMessage", lsA
   if ucase$(lsA) = "YES" then
      glFlags = glFlags or %gbfLogInvalidInMessage
   end if
   LogIt 1, "Flgs LogInvalidInMessage=" & iif$((glFlags and %gbfLogInvalidInMessage), "Yes", "No")

   ' Set create database allowed flag
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "CreateDatabaseAllowed", lsA
   if ucase$(lsA) = "YES" then
      glFlags = glFlags or %gbfCreateDatabaseAllowed
   end if
   LogIt 1, "Flgs CreateDatabaseAllowed=" & iif$((glFlags and %gbfCreateDatabaseAllowed), "Yes", "No")

   ' Set max chunk size
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "MaxChunkSize", lsA
   if val(lsA) >= 1 then gwMaxChunkSizeK = val(lsA)
   LogIt 1, "Data MaxChunkSize=" & format$(gwMaxChunkSizeK)

   ' Set connection timeout
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "ConnectionTimeout", lsA
   if val(lsA) >= 1 or val(lsA) = -1 then giConnectionTimeout = val(lsA)
   LogIt 1, "Data ConnectionTimeout=" & format$(giConnectionTimeout)

   ' Get all FACT entries
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "FACT", "", lsEntries
   if len(lsEntries) then

      ' Process each FACT_ entry
      redim gsaFACT(1 to parsecount(lsEntries, $NUL))
      for llDo = 1 to ubound(gsaFACT)
         lsFile = parse$(lsEntries, $NUL, llDo)
         arGetIni curdir$ & "\SQLiteningServer.Cfg", "FACT", bycopy lsFile, lsA
         lsPasswords = $NUL
         for llDo2 = 1 to parsecount(lsA)
            lsPasswords = lsPasswords & parse$(lsA, llDo2) & $NUL
         next
         ' Each entry has the file name followed by a colon followed by the passwords.
         ' Each password begins and ends with $NUL
         gsaFACT(llDo) = ucase$(lsFile) & ":" & lsPasswords
      next
      LogIt 1, "FACT Loaded"

   else
      ' No FACT section or no entries so erase table if there
      if ubound(gsaFACT) > 0 then
         erase gsaFACT
         LogIt 1, "FACT Erased"
      else
         LogIt 1, "FACT Non To Load"
      end if

   end if

   ' Exit OK
   function = %True

End Function

'========================<[ Start Listeners ]>=========================
Function StartListeners as Long

   Local llDo as Long
   Local lhPort, lhIPAddress as Dword
   Local lsA as String
   Local lsServiceSuffix as String
   Dim lsaCfg(0) as String

   ' Get the port from the .Cfg file. If none there then
   ' will use default of 51234
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "Port", lsA
   if isfalse len(lsA) or ucase$(lsA) = "DEFAULT" then
      lsA = "51234"
   else
      if verify(lsA, "0123456789") then LogIt 5, "Invalid Port " & lsA : exit function
   end if
   lhPort = val(lsA)

   ' Get the service name suffix
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "ServiceNameSuffix", lsServiceSuffix

   ' Get the Hosts from the .Cfg file.  This program can
   ' be set to be multi-homed - that is,
   ' listen on more than one IP address (host).
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "Hosts", lsA
   if isfalse len(lsA) then
      LogIt 5, "No Hosts"
      exit function
   end if

   ' Start all IP ports listening now
   dim guaListeners(1 to parsecount(lsA))
   for llDo = 1 to parsecount(lsA)
      ' Get a file number
      guaListeners(llDo).lTcpFileNumber = freefile
      ' Convert host to IP
      host addr parse$(lsA, llDo) To lhIPAddress
      if isfalse lhIPAddress then
         LogIt 5, "Invalid IP Address " & parse$(lsA, llDo)
         exit function
      end if
      ' Open and check for error
      tcp open server addr lhIPAddress port lhPort As guaListeners(llDo).lTcpFileNumber
      if err then
         LogIt 5, "TCP Open timeout for " & parse$(lsA, llDo)
         exit function
      end if
      ' Save the socket handle
      guaListeners(llDo).hSocket = fileattr(guaListeners(llDo).lTcpFileNumber, 2)
      ' Set to be notified when user wants to connect
      tcp notify guaListeners(llDo).lTcpFileNumber, accept to ghWinHand As %Tcp_Notify
      ' Log it
      LogIt 2, parse$(lsA, llDo) & _
            "(" & format$(lo(byte,lo(word, lhIPAddress))) & "." & format$(hi(byte,lo(word, lhIPAddress))) & "." & format$(lo(byte,hi(word, lhIPAddress))) & "." & format$(hi(byte,hi(word, lhIPAddress))) & _
            ")  Socket=" & format$(guaListeners(llDo).hSocket) & "  Port=" & format$(lhPort) & "  ServiceNameSuffix=" & lsServiceSuffix
   next

   ' Exit OK
   function = %True

End Function

'=======================<[ Accept Connection ]>========================
Sub AcceptConnection(byval rhSocket as Dword)

   Local llIX as Long
   Local llTcpFileNumber as Long
   Local lqA as Quad
   Local lhA as Dword

   ' Someone is attempting to connect to the server so
   ' determine which socket this is coming in on.
   array scan guaListeners(), from 5 to 8, = mkdwd$(rhSocket), to llIX
   if isfalse llIX then
      LogIt 5, "Connect can not find socket"
      exit sub
   end if

   ' Now we know which socket the connect request is coming
   ' in on and which one we should assign it to,
   ' so accept the connection and specify the notify events
   llTcpFileNumber = freefile
   tcp accept guaListeners(llIX).lTcpFileNumber as llTcpFileNumber

   ' Create thread to handle connection and then close
   ' its handle cause we do not need it
   lqA = mak(Quad, llTcpFileNumber, guaListeners(llIX).hSocket)
   thread create ConnectionMain(varptr(lqA)) To lhA
   ' Must sleep a bit so thread will start and get the passed parms.
   sleep 5
   thread close lhA to lhA

End Sub

'===========================<[ Dispatcher ]>===========================
Callback Function Dispatcher

   select case CbMsg

   case %WM_InitDialog
      if StartListeners then
         glFlags = glFlags or %gbfServerStartedOK

      else
         glFlags = glFlags or %gbfServerStartUpFailed
      end if

   case %Tcp_Notify
      if lo(word, cblParam) = %FD_Accept then AcceptConnection cbwParam ' cbwParam contains the handle of the socket (FileAttr(hSock, 2) from accept event)

   end select

End Function

'========================<[ Service Handler ]>=========================
Sub ServiceHandler(byval rlControlValue as Long)

   select case long rlControlValue
   case %SERVICE_CONTROL_STOP, %SERVICE_CONTROL_SHUTDOWN

      ' Set status to stopping
      guServiceStatus.dwCurrentState = %SERVICE_STOP_PENDING
      if isfalse SetServiceStatus(ghServiceStatusHandle, guServiceStatus) then exit sub

      'Stop server
      StopServer

      ' Set the event and flag so the service will stop
      SetEvent glEndEventHandle

   case %SERVICE_CONTROL_INTERROGATE
      if isfalse SetServiceStatus(ghServiceStatusHandle, guServiceStatus) then exit sub

   end select

End Sub

'==========================<[ Service Main ]>==========================
Sub ServiceMain(byval rhArgCount as Dword, _
                byval rhpArgs as Dword)
'  This is called by service manager for us to start the SQLitening service.

   Local lhA as Dword
   Local luSA as SecurityAttributes_TYPE

   ' Register with the SCM
   ghServiceStatusHandle = RegisterServiceCtrlHandler(bycopy gsServiceName, codeptr(ServiceHandler))
   if isfalse ghServiceStatusHandle then exit sub

   ' Set status to starting
   guServiceStatus.dwCurrentState = %SERVICE_START_PENDING
   if isfalse SetServiceStatus(ghServiceStatusHandle, guServiceStatus) then exit sub

   ' Start and run the server as a separate thread
   thread create RunServerThread(0) to lhA
   thread close lhA to lhA

   ' Must loop and wait for server to start OK or to fail
   reset lhA
   do
      sleep 10
      if (glFlags and %gbfServerStartUpFailed) or lhA >= 500 then

         ' Set status to stopped caus there was a failure or we waited too long
         guServiceStatus.dwCurrentState = %SERVICE_STOPPED
         SetServiceStatus ghServiceStatusHandle, guServiceStatus
         exit sub

      end if

      ' Set status to still starting
      incr lhA
      guServiceStatus.dwCurrentState = %SERVICE_START_PENDING
      if isfalse SetServiceStatus(ghServiceStatusHandle, guServiceStatus) then exit sub

   loop until (glFlags and %gbfServerStartedOK)

   ' Set status to started
   guServiceStatus.dwCurrentState = %SERVICE_RUNNING
   if isfalse SetServiceStatus(ghServiceStatusHandle, guServiceStatus) then exit sub

   ' Create wait event
   glEndEventHandle = CreateEvent(luSA, %TRUE, %FALSE, "")

   ' Wait for the signal to end
   WaitForSingleObject glEndEventHandle, %INFINITE
   CloseHandle glEndEventHandle

   ' Set status to stopped
   guServiceStatus.dwCurrentState = %SERVICE_STOPPED
   SetServiceStatus ghServiceStatusHandle, guServiceStatus

End Sub

'=============================<[ Mainer ]>=============================
Function WinMain(byval rhInstance as Dword, _
                 byval rhPrevInst as Dword, _
                 byval rlpCmdLine as Asciz Ptr, _
                 byval lrCmdShow as Long) as Long

   Local llA as Long
   Dim luaSTE(1 to 2) as ServiceTableEntry_TYPE

   ' Set current folder
   chdir  exe.path$

   ' Init service status
   guServiceStatus.dwServiceType = %SERVICE_WIN32_OWN_PROCESS
   guServiceStatus.dwControlsAccepted = %SERVICE_ACCEPT_STOP Or %SERVICE_ACCEPT_SHUTDOWN

   ' Init service entry
   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "ServiceNameSuffix", gsServiceName
   gsServiceName = "SQLiteningServer" & gsServiceName
   luaSTE(1).lpServiceName = strptr(gsServiceName)
   luaSTE(1).lpServiceProc = CodePtr(ServiceMain)

   ' Start service dispatcher if command line parm is &HFF.  This is a code which
   ' was set when service installed
   if command$ = chr$(&HFF) then
      ' Called by service manager.  The following API will call ServiceMain
      StartServiceCtrlDispatcher(luaSTE(1))
   elseif isfalse len(command$) then
      ' Called by windows so run admin program
      llA = shell("SQLiteningServerAdmin")
   else
      msgbox "Invalid command line=" & command$, 0, "SQLitening Server"
   end if

End Function
